Práctica Aprendizaje Automático
Alonso Rescalvo Casas, Gabriel Carlos Suárez Chiquito y Marc Gil Arnau. Grupo 2
2025-02-16
1 Comprensión del problema. Explicación. Lectura de datos. Particiones.
El conjunto de datos sirve para intentar predecir cómo de probable es sufrir un derrame cerebral a partir de unos parámetros. Los datos han sido extraídos del repositorio Kaggle predicción derrame cerebral. Según la OMS, los derrames cerebrales son la segunda causa de mortalidad, responsables de aproximadamente el 11% de las muertes en el mundo.
Este conjunto de datos permite predecir si es probable que un paciente sufra un accidente cerebrovascular en función de parámetros como el sexo, la edad, diversas enfermedades y el tabaquismo. Cada fila de los datos proporciona información relevante sobre el paciente.
1.1 Variables del dataset:
- id: Identificador único
- gender: “Masculino”, “Femenino”, “Otros”
- age: Edad del paciente en años
- hypertension: 0 si no tiene hipertensión, 1 si tiene hipertensión
- heart_disease: 0 si no tiene enfermedades cardíacas, 1 si tiene
- ever_married: “No” o “Yes”
- work_type: “children”, “Govt_job”, “Never_worked”, “Private”, “Self-employed”
- Residence_type: “Rural” o “Urban”
- avg_glucose_level: Media de glucosa en sangre
- bmi: Índice de masa corporal (IMC)
- smoking_status: “formerly smoked”, “never smoked”, “smokes”, “Unknown”
- stroke: 1 si ha sufrido un derrame, 0 si no
1.2 Carga y exploración inicial de los datos
library(readr)
library(dplyr)##
## Adjuntando el paquete: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(caret)## Cargando paquete requerido: ggplot2## Cargando paquete requerido: latticelibrary(ggplot2)
library(corrplot)## corrplot 0.95 loadedlibrary(readr)
library(cluster)
library(factoextra)## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa# Cargamos los datos
datos <- read.csv("healthcare-dataset-stroke-data.csv", sep=",", header=TRUE)1.3 Partición en train-test-validation
set.seed(10)
ntotal <- dim(datos)[1]
indices <- 1:ntotal
ntrain <- ntotal * 0.6
indices_train <- sample(indices, ntrain, replace = FALSE)
indices_restantes <- indices[-indices_train]
ntest <- length(indices_restantes) * 0.5
indices_test <- sample(indices_restantes, ntest, replace = FALSE)
indices_val <- indices[-c(indices_train, indices_test)]
train <- datos[indices_train,]
test <- datos[indices_test,]
val <- datos[indices_val,]
# Comprobamos la partición
dim(train)## [1] 3066 12dim(test)## [1] 1022 12dim(val)## [1] 1022 122 Preparación de datos y análisis exploratorio de datos.
Ver dimensiones de train
dim(train)## [1] 3066 12Se observa que tiene 3066 observaciones y 12 variables.
# Primer vistazzo a los datos
str(train)## 'data.frame': 3066 obs. of 12 variables:
## $ id : int 50965 46292 34257 57870 15988 43913 48323 29804 12345 16774 ...
## $ gender : chr "Male" "Male" "Male" "Male" ...
## $ age : num 53 64 17 54 60 21 53 24 11 79 ...
## $ hypertension : int 0 0 0 0 1 0 0 1 0 0 ...
## $ heart_disease : int 0 0 0 0 0 0 0 0 0 0 ...
## $ ever_married : chr "No" "Yes" "No" "Yes" ...
## $ work_type : chr "Private" "Private" "Govt_job" "Private" ...
## $ Residence_type : chr "Rural" "Rural" "Urban" "Rural" ...
## $ avg_glucose_level: num 65.2 90.1 68.9 89.4 197.1 ...
## $ bmi : chr "28.9" "28.6" "23" "42.4" ...
## $ smoking_status : chr "Unknown" "never smoked" "Unknown" "smokes" ...
## $ stroke : int 0 0 0 0 0 0 0 0 0 0 ...head(train)## id gender age hypertension heart_disease ever_married work_type
## 491 50965 Male 53 0 0 No Private
## 3721 46292 Male 64 0 0 Yes Private
## 3402 34257 Male 17 0 0 No Govt_job
## 4464 57870 Male 54 0 0 Yes Private
## 1608 15988 Male 60 1 0 Yes Private
## 1462 43913 Female 21 0 0 No Private
## Residence_type avg_glucose_level bmi smoking_status stroke
## 491 Rural 65.24 28.9 Unknown 0
## 3721 Rural 90.07 28.6 never smoked 0
## 3402 Urban 68.91 23 Unknown 0
## 4464 Rural 89.41 42.4 smokes 0
## 1608 Urban 197.09 34.3 Unknown 0
## 1462 Rural 107.98 26.9 never smoked 0View(train)Podemos ver como hemos importado el bmi como ‘character’ y esto no tiene sentido ya que debería de tratarse de una variable continua.
table(train$bmi)##
## 10.3 11.3 12 12.8 13 13.2 13.3 13.4 13.5 13.7 13.9 14 14.1 14.2 14.3 14.5
## 1 1 1 1 1 1 1 1 1 1 1 1 3 4 1 2
## 14.6 14.8 14.9 15 15.1 15.2 15.3 15.4 15.5 15.6 15.7 15.8 15.9 16 16.1 16.2
## 3 2 1 2 6 2 3 3 4 2 2 4 3 5 6 4
## 16.3 16.4 16.5 16.6 16.7 16.8 16.9 17 17.1 17.2 17.3 17.4 17.5 17.6 17.7 17.8
## 7 7 2 7 5 4 6 8 8 5 6 8 5 13 7 4
## 17.9 18 18.1 18.2 18.3 18.4 18.5 18.6 18.7 18.8 18.9 19 19.1 19.2 19.3 19.4
## 6 9 8 6 11 7 7 9 6 8 5 2 9 11 6 8
## 19.5 19.6 19.7 19.8 19.9 20 20.1 20.2 20.3 20.4 20.5 20.6 20.7 20.8 20.9 21
## 12 5 3 10 6 10 14 10 11 13 9 8 6 14 8 10
## 21.1 21.2 21.3 21.4 21.5 21.6 21.7 21.8 21.9 22 22.1 22.2 22.3 22.4 22.5 22.6
## 8 10 18 13 19 8 10 9 10 7 9 18 8 15 10 11
## 22.7 22.8 22.9 23 23.1 23.2 23.3 23.4 23.5 23.6 23.7 23.8 23.9 24 24.1 24.2
## 11 15 11 14 6 9 9 20 16 16 11 15 15 20 18 15
## 24.3 24.4 24.5 24.6 24.7 24.8 24.9 25 25.1 25.2 25.3 25.4 25.5 25.6 25.7 25.8
## 16 17 15 13 15 18 15 14 22 11 20 14 16 13 10 12
## 25.9 26 26.1 26.2 26.3 26.4 26.5 26.6 26.7 26.8 26.9 27 27.1 27.2 27.3 27.4
## 16 13 22 15 16 24 16 13 18 13 22 24 20 14 17 11
## 27.5 27.6 27.7 27.8 27.9 28 28.1 28.2 28.3 28.4 28.5 28.6 28.7 28.8 28.9 29
## 19 25 25 15 19 21 20 17 18 23 11 12 28 13 18 18
## 29.1 29.2 29.3 29.4 29.5 29.6 29.7 29.8 29.9 30 30.1 30.2 30.3 30.4 30.5 30.6
## 16 15 12 18 15 14 16 13 14 18 15 10 16 11 14 12
## 30.7 30.8 30.9 31 31.1 31.2 31.3 31.4 31.5 31.6 31.7 31.8 31.9 32 32.1 32.2
## 13 15 16 13 13 14 12 15 16 13 10 17 9 13 13 10
## 32.3 32.4 32.5 32.6 32.7 32.8 32.9 33 33.1 33.2 33.3 33.4 33.5 33.6 33.7 33.8
## 16 10 12 14 13 15 9 11 12 12 8 8 12 4 12 10
## 33.9 34 34.1 34.2 34.3 34.4 34.5 34.6 34.7 34.8 34.9 35 35.1 35.2 35.3 35.4
## 8 11 10 11 12 8 14 5 13 6 5 8 7 10 8 4
## 35.5 35.6 35.7 35.8 35.9 36 36.1 36.2 36.3 36.4 36.5 36.6 36.7 36.8 36.9 37
## 6 9 8 14 10 6 1 7 8 5 3 8 13 4 5 6
## 37.1 37.2 37.3 37.4 37.5 37.6 37.7 37.8 37.9 38 38.1 38.2 38.4 38.5 38.6 38.7
## 3 7 10 9 5 8 4 5 7 9 5 4 3 2 8 8
## 38.8 38.9 39 39.1 39.2 39.3 39.4 39.5 39.6 39.7 39.8 39.9 40 40.1 40.2 40.3
## 7 8 3 6 8 3 5 2 7 5 2 4 4 6 7 7
## 40.4 40.5 40.6 40.7 40.8 40.9 41 41.1 41.2 41.3 41.5 41.6 41.7 41.8 41.9 42
## 3 5 1 1 4 5 2 4 5 4 3 3 3 6 3 3
## 42.1 42.2 42.3 42.4 42.5 42.6 42.7 42.8 42.9 43 43.1 43.2 43.3 43.4 43.6 43.7
## 2 4 4 3 2 2 2 1 1 5 4 1 1 4 1 3
## 43.8 43.9 44 44.1 44.2 44.3 44.4 44.5 44.6 44.7 44.8 44.9 45 45.1 45.2 45.3
## 5 6 3 1 4 3 1 2 1 3 2 1 5 1 2 2
## 45.4 45.5 45.8 45.9 46 46.2 46.4 46.5 46.6 47.1 47.3 47.5 47.6 47.8 47.9 48.3
## 3 3 1 2 3 1 1 1 1 1 2 1 2 2 1 1
## 48.4 48.5 48.8 48.9 49.3 49.4 49.8 49.9 50.1 50.2 50.3 50.4 51 51.5 51.7 51.9
## 1 2 1 3 2 1 2 1 1 2 2 1 1 1 1 1
## 52.3 52.7 52.8 52.9 53.4 53.8 53.9 54 54.1 54.3 54.6 54.7 55 55.1 55.7 55.9
## 1 1 2 1 1 1 1 1 1 1 1 3 1 1 2 2
## 56.6 57.2 57.3 57.5 57.9 58.1 60.2 60.9 61.2 63.3 64.8 66.8 92 97.6 N/A
## 2 1 1 1 1 1 1 2 1 1 1 1 1 1 126Vemos que hay 201 valores faltantes pero están como N/A y no como NA, por eso trata la variable como chr.
2.1 Limpieza de datos
Ponemos los datos faltantes que estan como char en verdaderos datos faltantes como NA
# Convertimos los valores "N/A" en NA en bmi
train$bmi[train$bmi == "N/A"] <- NA
#Convertimos datos faltantes unknown en NA
train$smoking_status[train$smoking_status == "Unknown"]<-NA
#Comprobamos que se ha cambiado correctamente
table(train$bmi)##
## 10.3 11.3 12 12.8 13 13.2 13.3 13.4 13.5 13.7 13.9 14 14.1 14.2 14.3 14.5
## 1 1 1 1 1 1 1 1 1 1 1 1 3 4 1 2
## 14.6 14.8 14.9 15 15.1 15.2 15.3 15.4 15.5 15.6 15.7 15.8 15.9 16 16.1 16.2
## 3 2 1 2 6 2 3 3 4 2 2 4 3 5 6 4
## 16.3 16.4 16.5 16.6 16.7 16.8 16.9 17 17.1 17.2 17.3 17.4 17.5 17.6 17.7 17.8
## 7 7 2 7 5 4 6 8 8 5 6 8 5 13 7 4
## 17.9 18 18.1 18.2 18.3 18.4 18.5 18.6 18.7 18.8 18.9 19 19.1 19.2 19.3 19.4
## 6 9 8 6 11 7 7 9 6 8 5 2 9 11 6 8
## 19.5 19.6 19.7 19.8 19.9 20 20.1 20.2 20.3 20.4 20.5 20.6 20.7 20.8 20.9 21
## 12 5 3 10 6 10 14 10 11 13 9 8 6 14 8 10
## 21.1 21.2 21.3 21.4 21.5 21.6 21.7 21.8 21.9 22 22.1 22.2 22.3 22.4 22.5 22.6
## 8 10 18 13 19 8 10 9 10 7 9 18 8 15 10 11
## 22.7 22.8 22.9 23 23.1 23.2 23.3 23.4 23.5 23.6 23.7 23.8 23.9 24 24.1 24.2
## 11 15 11 14 6 9 9 20 16 16 11 15 15 20 18 15
## 24.3 24.4 24.5 24.6 24.7 24.8 24.9 25 25.1 25.2 25.3 25.4 25.5 25.6 25.7 25.8
## 16 17 15 13 15 18 15 14 22 11 20 14 16 13 10 12
## 25.9 26 26.1 26.2 26.3 26.4 26.5 26.6 26.7 26.8 26.9 27 27.1 27.2 27.3 27.4
## 16 13 22 15 16 24 16 13 18 13 22 24 20 14 17 11
## 27.5 27.6 27.7 27.8 27.9 28 28.1 28.2 28.3 28.4 28.5 28.6 28.7 28.8 28.9 29
## 19 25 25 15 19 21 20 17 18 23 11 12 28 13 18 18
## 29.1 29.2 29.3 29.4 29.5 29.6 29.7 29.8 29.9 30 30.1 30.2 30.3 30.4 30.5 30.6
## 16 15 12 18 15 14 16 13 14 18 15 10 16 11 14 12
## 30.7 30.8 30.9 31 31.1 31.2 31.3 31.4 31.5 31.6 31.7 31.8 31.9 32 32.1 32.2
## 13 15 16 13 13 14 12 15 16 13 10 17 9 13 13 10
## 32.3 32.4 32.5 32.6 32.7 32.8 32.9 33 33.1 33.2 33.3 33.4 33.5 33.6 33.7 33.8
## 16 10 12 14 13 15 9 11 12 12 8 8 12 4 12 10
## 33.9 34 34.1 34.2 34.3 34.4 34.5 34.6 34.7 34.8 34.9 35 35.1 35.2 35.3 35.4
## 8 11 10 11 12 8 14 5 13 6 5 8 7 10 8 4
## 35.5 35.6 35.7 35.8 35.9 36 36.1 36.2 36.3 36.4 36.5 36.6 36.7 36.8 36.9 37
## 6 9 8 14 10 6 1 7 8 5 3 8 13 4 5 6
## 37.1 37.2 37.3 37.4 37.5 37.6 37.7 37.8 37.9 38 38.1 38.2 38.4 38.5 38.6 38.7
## 3 7 10 9 5 8 4 5 7 9 5 4 3 2 8 8
## 38.8 38.9 39 39.1 39.2 39.3 39.4 39.5 39.6 39.7 39.8 39.9 40 40.1 40.2 40.3
## 7 8 3 6 8 3 5 2 7 5 2 4 4 6 7 7
## 40.4 40.5 40.6 40.7 40.8 40.9 41 41.1 41.2 41.3 41.5 41.6 41.7 41.8 41.9 42
## 3 5 1 1 4 5 2 4 5 4 3 3 3 6 3 3
## 42.1 42.2 42.3 42.4 42.5 42.6 42.7 42.8 42.9 43 43.1 43.2 43.3 43.4 43.6 43.7
## 2 4 4 3 2 2 2 1 1 5 4 1 1 4 1 3
## 43.8 43.9 44 44.1 44.2 44.3 44.4 44.5 44.6 44.7 44.8 44.9 45 45.1 45.2 45.3
## 5 6 3 1 4 3 1 2 1 3 2 1 5 1 2 2
## 45.4 45.5 45.8 45.9 46 46.2 46.4 46.5 46.6 47.1 47.3 47.5 47.6 47.8 47.9 48.3
## 3 3 1 2 3 1 1 1 1 1 2 1 2 2 1 1
## 48.4 48.5 48.8 48.9 49.3 49.4 49.8 49.9 50.1 50.2 50.3 50.4 51 51.5 51.7 51.9
## 1 2 1 3 2 1 2 1 1 2 2 1 1 1 1 1
## 52.3 52.7 52.8 52.9 53.4 53.8 53.9 54 54.1 54.3 54.6 54.7 55 55.1 55.7 55.9
## 1 1 2 1 1 1 1 1 1 1 1 3 1 1 2 2
## 56.6 57.2 57.3 57.5 57.9 58.1 60.2 60.9 61.2 63.3 64.8 66.8 92 97.6
## 2 1 1 1 1 1 1 2 1 1 1 1 1 1table(train$smoking_status)##
## formerly smoked never smoked smokes
## 536 1119 467View(train)Vemos el tipo de datos que tenemos en train
str(train)## 'data.frame': 3066 obs. of 12 variables:
## $ id : int 50965 46292 34257 57870 15988 43913 48323 29804 12345 16774 ...
## $ gender : chr "Male" "Male" "Male" "Male" ...
## $ age : num 53 64 17 54 60 21 53 24 11 79 ...
## $ hypertension : int 0 0 0 0 1 0 0 1 0 0 ...
## $ heart_disease : int 0 0 0 0 0 0 0 0 0 0 ...
## $ ever_married : chr "No" "Yes" "No" "Yes" ...
## $ work_type : chr "Private" "Private" "Govt_job" "Private" ...
## $ Residence_type : chr "Rural" "Rural" "Urban" "Rural" ...
## $ avg_glucose_level: num 65.2 90.1 68.9 89.4 197.1 ...
## $ bmi : chr "28.9" "28.6" "23" "42.4" ...
## $ smoking_status : chr NA "never smoked" NA "smokes" ...
## $ stroke : int 0 0 0 0 0 0 0 0 0 0 ...Variables discretas: id, hypertension, heart_disease y stroke.
Variables continuas: age, avg_glucose_level y bmi.
Variables texto: gender, ever_married, work_type, Residence_type y smoking_status.
Se observa que hay tres variables continuas que son age, avg_glucose_level y bmi que estan en tipo num lo cual es correcto.
Por otro lado las variables residen_type, smoking_status y work_type son de tipo char y tienen que ser factor por lo que las convertimos a tipo factor.
Y tenemos claro que la columna “id” no será relevante en nuestro modelo, después de todo, el ID de una persona registrada no tendrá influencia en el diagnóstico (no tendré un tumor sólo por mi ID).
Por lo tanto, podemos eliminar esta columna de nuestro conjunto de datos, para no influir en la construcción del modelo.
#borramos coluna id
train <- train[, -which(names(train) == "id")]train$ever_married <- factor(train$ever_married)
train$Residence_type <- factor(train$Residence_type)
train$smoking_status <- factor(train$smoking_status)
train$work_type <- factor(train$work_type)
train$stroke <- factor(train$stroke)
train$hypertension <- factor(train$hypertension)
train$heart_disease <- factor(train$heart_disease)
train$gender <- factor(train$gender)
str(train)## 'data.frame': 3066 obs. of 11 variables:
## $ gender : Factor w/ 3 levels "Female","Male",..: 2 2 2 2 2 1 2 2 2 1 ...
## $ age : num 53 64 17 54 60 21 53 24 11 79 ...
## $ hypertension : Factor w/ 2 levels "0","1": 1 1 1 1 2 1 1 2 1 1 ...
## $ heart_disease : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
## $ ever_married : Factor w/ 2 levels "No","Yes": 1 2 1 2 2 1 2 2 1 1 ...
## $ work_type : Factor w/ 5 levels "children","Govt_job",..: 4 4 2 4 4 4 2 4 1 5 ...
## $ Residence_type : Factor w/ 2 levels "Rural","Urban": 1 1 2 1 2 1 1 1 2 2 ...
## $ avg_glucose_level: num 65.2 90.1 68.9 89.4 197.1 ...
## $ bmi : chr "28.9" "28.6" "23" "42.4" ...
## $ smoking_status : Factor w/ 3 levels "formerly smoked",..: NA 2 NA 3 NA 2 NA 3 2 NA ...
## $ stroke : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...Se puede observar que ya esta corregido lo que se observo anteriormente y que ya están en factor.
2.2 Gráficos de distribucion de las variables
Ahora vamos a ver gráficos de la distribución y frecuencia de las algunas de las variables.
#Psar bmi a varuable numerica
train$bmi <- as.numeric(train$bmi)
str(train$bmi)## num [1:3066] 28.9 28.6 23 42.4 34.3 26.9 26.7 28.2 27.6 39.2 ...Grafico en función del tipo de trabajo
ggplot(train) + geom_bar(aes(x = work_type))
- El primer gráfico muestra el numero de personas segun su sector de trabajo(cildren, govt_job, nerver_worked, Private, Self-eemployed) Se puede observar que la gran mayoria de poblacion trabaja en el sector privado y que ua minoria no trabaja. No se observa ninguna anomalia
ggplot(train, aes(x = age)) + geom_histogram(binwidth = 5, fill = "blue", color = "black", alpha = 0.7) + theme_minimal() + labs(title = "Distribución de la Edad", x = "Edad", y = "Frecuencia")
El histograma muestra la distribución de edades en la población estudiada.
Se puede observar que la frecuencia aumenta a medida que avanza en el rango de edad hasta alrededor de los 55-60 años, donde la barra es más alta. A partir de ahí, la frecuencia parece disminuir ligeramente, excepto por una barra muy alta al final.
Esto indica que hay una mayor concentración de individuos en el rango de edad medio-alto (55-60 años), y también hay un grupo considerable de personas de edad avanzada (alrededor de los 80 años).
ggplot(train, aes(x = gender)) + geom_bar(fill = "lightblue", color = "black") + theme_minimal() + labs(title = "Distribución del Género", x = "Género", y = "Frecuencia")
El histograma muestra la distribución del género de la muestra estudiada.
Se puede observar que hay más mujeres (“Female”) que hombres (“Male”) en el conjunto de datos, con una diferencia considerable en las frecuencias.
Por otro lado se muestra una categoría other la cual es una minoria compuesta por un solo miembro.
Decisión sobre la categoría “Other” Dado que la categoría “Other” solo contiene un individuo, mantenerla como una categoría separada podría dificultar el modelado predictivo debido al desequilibrio extremo. Para mejorar el modelo, se propone reasignar este individuo a la categoría mayoritaria (“Female” o “Male”). Esto permitirá reducir el ruido causado por categorías con muy pocos datos.
# Reasignar la categoría "Other" al género mayoritario ("Female")
train$gender[train$gender == "Other"] <- "Female"
# Verificar nuevamente las frecuencias
table(train$gender)##
## Female Male Other
## 1781 1285 0Como se obserba la categoria other ha desaparecido y la categoria Female tiene un individuo adicional.
ggplot(train, aes(x = smoking_status)) + geom_bar(fill = "lightgreen", color = "black") + theme_minimal() + labs(title = "Distribución del Estado de Tabaquismo", x = "Estado de Tabaquismo", y = "Frecuencia")
ggplot(train, aes(x = stroke)) + geom_bar(fill = "lightgreen", color = "black") + theme_minimal() + labs(title = "Distribución de stroke", x = "Stroke", y = "Frecuencia")
2.3 Comparar variable objetivo respecto a las distintas variables
2.3.1 Stroke vs age
# Gráfico de densidad con 'stroke' como factor
ggplot(train, aes(x = age, color = stroke)) +
geom_density(lwd = 2, linetype = 1) +
theme_minimal() +
labs(title = "Distribución de la Edad según Derrame Cerebral",
x = "Edad", y = "Densidad")
En estos dos gráficos se puede observar que la edad y la posibilidad de tener un derrame se ve aumentada considerablemente según la edad aumenta.
ggplot(datos) +
geom_point(aes(x = age, y = stroke), stat = "summary", fun = "mean") +
ggtitle("Probabilidad de derrame según Edad") +
ylab("Stroke probability")
Se observa que a edades tempranas (0-30 años), la probabilidad de sufrir un derrame cerebral es cercana a 0. A partir de los 40 años, la probabilidad comienza a aumentar gradualmente. A partir de los 60-80 años, hay un incremento notable en la probabilidad de sufrir un derrame. Interpretación:
El gráfico sugiere que la edad está positivamente correlacionada con el riesgo de sufrir un derrame cerebral. En edades avanzadas (mayores de 60-70 años), la probabilidad se vuelve mucho más alta, lo cual es consistente con lo que se espera en estudios médicos.
A su vez se observa un repunte en un año de la probabilidad de tener un derrame ya que hubo un bebe que tuve un derrame es un caso fuera de lo normal y al ser la muestra no muy grande hay un repunte.
ggplot(datos) +
stat_summary_bin(aes(x = age, y = stroke), bins = 10, fun = "mean", geom = "col", fill = "steelblue") +
ggtitle("Probabilidad de derrame según Edad, agrupado") +
xlab("Age Group") +
ylab("Stroke probability") +
theme_minimal()
Este gráfico agrupa a las personas en grupos de 10 en 10, y ya no se muestra ese repunte que se observaba en el gráfico anterior debido que al agruparlos hay más muestras, se sigue observando la misma tendencia a cuanto más edad, mayor es la probabilidad de tener un derrame
# Boxplot para la edad en función de si se sufrió un derrame cerebral
ggplot(train, aes(x = (stroke), y = age, fill = stroke)) +
geom_boxplot() + theme_minimal() + labs(title = "Distribución de la Edad según Derrame Cerebral", x = "Derrame Cerebral", y = "Edad")
La gente con mayor edad a tenido un derrame. Hay dos casos aislados mas abajo de un bebe y un joven pero tras ivestigar si es posible que un bebe tenga un derrame por lo que es algo anomalo pero no imposible. Por lo que en proporción a cuanto más edad tengamos más probable sera que tengamos un derrame
2.3.2 Stroke vs BMI
ggplot(na.omit(train), aes(x = bmi, color = stroke)) +
geom_density(lwd = 2, linetype = 1) +
theme_minimal() +
labs(title = "Distribución de BMI según densidad de Derrame Cerebral",
x = "BMI", y = "Densidad")
El primer gráfico muestra la frecuencia de que una persona tuviera un derrame según su bmi. En este gráfico no podemos observar ninguna tendencia muy bien y se podria lleagr a decir que el bmi no afecta en tener un derrame.
Pero si lo comparamos el segundo confirmamos lo que decíamos previamente, y el bmi no afecta al riesgo de tener un derrame cerebral o aumenta muy ligeramnete el riesgo.
# Boxplot para BMI según si ha habido un derrame cerebral
ggplot(na.omit(train), aes(x = stroke, y = bmi, fill = stroke)) +
geom_boxplot() +
theme_minimal() +
labs(title = "Distribución del BMI según Derrame Cerebral", x = "Derrame Cerebral", y = "Índice de Masa Corporal (BMI)") +
scale_fill_manual(values = c("lightblue", "lightcoral"))
En el boxplot se observa lo visto anteriormente, que el bmi no tiene mucha relevancia en cuanto a tener un derrame.
2.3.3 Stroke vs Glucosa
# Boxplot para los niveles de glucosa en función de si se sufrió un derrame cerebral
ggplot(na.omit(train), aes(x = stroke, y = avg_glucose_level, fill = stroke)) + geom_boxplot() + theme_minimal() + labs(title = "Distribución de la Glucosa Promedio según Derrame Cerebral", x = "Derrame Cerebral", y = "Nivel de Glucosa")
Se ha estudiado la relacion entre la glucosa y stroke. Se observa que tienen una relacion entre cuanto mas alto tengas el nivel de glucosa mas gente puede llegar a tener un derrame
ggplot(train, aes(x = avg_glucose_level, color = factor(stroke))) +
geom_density(lwd = 2, linetype = 1, na.rm = TRUE) +
theme_minimal() +
labs(title = "Distribución de Nivel de Glucosa según Densidad de Derrame Cerebral",
x = "Nivel de Glucosa", y = "Densidad")
En este gráfico de la Distribución de Nivel de glucosa según la densidad de Derrame Cerebral, se puede observar lo dicho anteriormente que ha cuanto mayor sea el nivel de glucosa mayor sera la probabilidad de que se tenga un derrame.
Las personas sin derrame cerebral tienden a tener niveles de glucosa más concentrados en rangos bajos (80-100)
ggplot(train, aes(x = age, y = avg_glucose_level, color = factor(stroke))) +
geom_point(alpha = 0.6, size = 2) +
theme_minimal() +
labs(title = "Relación entre Edad y Nivel de Glucosa según Derrame Cerebral",
x = "Edad", y = "Nivel de Glucosa",
color = "Derrame Cerebral")
En este gráfico se corrobora lo mencionado anteriormente a cuanto mas edad, es decir mas a la derecha muchas más proporción de la muestra sufre un derrame. Y a cuanto más glucosa también
2.3.4 Stroke vs Heart disease
ggplot(train, aes(x = heart_disease, fill = factor(stroke))) +
geom_bar(position = "fill") +
theme_minimal() +
labs(title = "Proporción de Derrames Cerebrales según problemas del corazón", x = "Problemas Cardíacos", y = "Proporción")
Este gráfico de barras apiladas muestra la proporción de derrames cerebrales (stroke) en función de si una persona tiene problemas cardíacos o no.
La proporción de personas con derrame cerebral es mayor en el grupo con problemas cardíacos, lo que nos dice que si hemos sufrido de algún problema del corazon somos más propensos a tener un derrame.
2.3.5 Stroke vs Hipertension
ggplot(train, aes(x = hypertension , fill = factor(stroke))) +
geom_bar(position = "fill") +
theme_minimal() +
labs(title = "Proporción de Derrames Cerebrales según hipertension", x = "Hipertension", y = "Proporción")
2.3.6 Stroke vs Smoking Status
# Gráfico de barras para el estado de tabaquismo binarizado según el derrame cerebral
ggplot(train, aes(x = smoking_status, fill = factor(stroke))) +
geom_bar(position = "fill") +
theme_minimal() +
labs(title = "Proporción de Derrames Cerebrales según Estado de Tabaquismo", x = "Estado de Tabaquismo", y = "Proporción")
Este gráfico de barras apiladas muestra la proporción de personas que han sufrido un derrame cerebral (“stroke”) según su estado de tabaquismo.
En todas las categorías de tabaquismo, la proporción de personas que han sufrido un derrame cerebral es pequeña en comparación con las que no han sufrido uno. Se observa un pequeño aumento en las personas que han llegado a fumar alguna vez
ggplot(train, aes(x=smoking_status , y=age, fill=smoking_status )) +
geom_violin()
En el gráfico se puede observar la distribución de las personas según su
edad y estado de tabaquismo.
se observa que hay bastantes NA pero la mayoría corrresponde ha población joven incluso niños, esto puede ser debido a que es algo a lo que los niños no pueden responder.
También se observa que no hay poblacion que sea niño que se sepa si fuma o no, son todos NA.
Otra cosa a resaltar en que la población que ha fumado alguna vez es población mayo de mas de 60 años mayoritariamente. Debido a esto se puede deber el aumento de proporción de gente que sufre derrames de la categoria fomerly smokes
2.3.7 Stroke vs work type
# Gráfico de barras para 'work_type' según si ha habido un derrame cerebral
ggplot(train, aes(x = work_type, fill = factor(stroke))) +
geom_bar(position = "fill") +
theme_minimal() +
labs(title = "Distribución de 'Work Type' según Derrame Cerebral", x = "Tipo de Trabajo", y = "Proporción")
En este gráfico se relaciona el tipo de trabajo con stroke. Se observa que en proporción los que trabajan para si mismos y trabajan para el sector privado tienen mas derrames. Pero no es nada concluyente, ya que es muy ligero la diferencia.
ggplot(train, aes(x = work_type, y = age, fill = work_type)) +
geom_boxplot(alpha = 0.7) +
theme_minimal() +
labs(title = "Distribución de Edad según Tipo de Trabajo",
x = "Tipo de Trabajo", y = "Edad") +
theme(legend.position = "none", axis.text.x = element_text(angle = 45, hjust = 1))
En este gráfico se obsrva la relacion entre el tipo trabajo y su edad. Vemos que la población perteneciente a children y nerver_worked son gente joven de menos de 18 años. Debido a esto en la relacion de tipo de trabajo con stroke de esto nos dale muy bajo o nulo la proprcion de stroke.
Por otro lado se observa que los self-employed, son un sector compuesto principalmente por gente de edades altas, debido a esto en el gráfico anterior , la gente perteneciente a self-employed tenia mayor proorción de gente que haya sufrido un derrame.
Por lo que se puede concluir que el tipo de trabajo no influye al si alguien puede ener un derrame, si no que esta mas relacionado con la edad y debido a la edad la categoria self-employed tiene mayor proporción de derrames.
2.3.8 Stroke vs Residence type
ggplot(train, aes(x = Residence_type, fill = factor(stroke))) +
geom_bar(position = "fill") +
theme_minimal() +
labs(title = "Proporción de Derrames Cerebrales según Residencia (Urbano/Rural)", x = "Tipo de Residencia", y = "Proporción")
Se observa la proporción de gente que tiene un derrame según su residencia rural o urbano. Se ven las dos gráficas muy similares por lo que no es algo que influya en si hay un derrame o no.
2.4 Análisis estadistico
2.4.1 Matriz de correlación de las varibles continuas
La matriz de correlacion mueestra la correlacion entre las variables age, avg_glucose_level y bmi, que son aquellas variables continuas
train_numeric <- na.omit(train[sapply(train, is.numeric)])
cor_matrix <- cor(train_numeric)
corrplot(cor_matrix, method = "color", col = colorRampPalette(c("blue", "white", "red"))(200), addCoef.col = "black", tl.col = "black", tl.cex = 0.8, title = "Matriz de correlación")
En la matriz se observa que todas las variables continuas tienen algo de relación pero destaca la relación de edad y bmi, cuanto mas edad tengamos, es más probable de que tengamos un bmi mas alto.
2.4.2 Calculos estadisticos (media, mediana, desviación…)
summary(train_numeric)## age avg_glucose_level bmi
## Min. : 0.08 Min. : 55.12 Min. :10.30
## 1st Qu.:25.00 1st Qu.: 77.52 1st Qu.:23.50
## Median :44.00 Median : 91.89 Median :28.00
## Mean :42.95 Mean :105.79 Mean :28.83
## 3rd Qu.:61.00 3rd Qu.:114.46 3rd Qu.:33.02
## Max. :82.00 Max. :271.74 Max. :97.60sd(train$age)## [1] 22.78564sd(train$avg_glucose_level)## [1] 45.20202sd(train$bmi, na.rm = TRUE)## [1] 7.957253Variable age El valor mínimo registrado es 0.08, lo que indica la presencia de un recién nacido en la muestra. El primer cuartil se encuentra en 25.00, lo que significa que el 25% de los individuos tiene menos de esa edad. La mediana es de 44.00, indicando que la mitad de la población analizada tiene menos de 44 años. La media es de 42.95, lo que muestra una distribución cercana a la mediana. El tercer cuartil es 61.00, lo que significa que el 75% de los individuos tiene menos de esta edad. El valor máximo registrado es 82.00 años. La desviación estándar calculada es de 22.79 años.
Variable avg_glucose_level (Nivel Promedio de Glucosa) El menor nivel de glucosa registrado es de 55.12 mg/dL, mientras que el primer cuartil se encuentra en 77.52 mg/dL, lo que indica que el 25% de las personas presenta niveles de glucosa por debajo de este valor. La mediana es de 91.89 mg/dL, representando el valor central de la distribución. La media es de 105.79 mg/dL, siendo mayor que la mediana, lo que sugiere la existencia de valores altos que podrían estar afectando la distribución. El tercer cuartil se encuentra en 114.46 mg/dL, indicando que el 75% de los individuos tiene valores inferiores a este umbral. El nivel máximo registrado es de 271.74 mg/dL, lo que sugiere la posible presencia de valores atípicos en la muestra, pero comprendidos entre lo posible por lo que son datos reales. Tiene una desviación tipica de 45,20 por lo que hay bastante dispersión
Valor mínimo registrado en la muestra es de 10.30. El primer cuartil es 23.50, lo que indica que el 25% de las personas tiene un IMC menor a este valor. La mediana es de 28.00, lo que refleja una tendencia al sobrepeso en la población analizada según los criterios de la Organización Mundial de la Salud (OMS). La media del IMC es de 28.83, lo que refuerza la tendencia observada en la mediana. El tercer cuartil es 33.02, indicando que el 75% de las personas tiene un IMC por debajo de este valor. El valor máximo registrado es de 97.60, lo cual es un dato anormalmente alto pero es algo posble por lo que no podemos eliminarlo de la base de datos.
2.4.3 Test de wilcox para ver si hay diferencias significativas
# Test de WIlcox
wilcox_age <- wilcox.test(age ~ stroke, data = train)
# Test de wilcox
wilcox_glucose <- wilcox.test(avg_glucose_level ~ stroke, data = train)
# Test de wilcox
wilcox_bmi <- wilcox.test(bmi ~ stroke, data = train, na.action = na.omit) # Omitimos los NA
# Resultados
cat("Resultado Wilcox: p =", wilcox_age$p.value, "\n")## Resultado Wilcox: p = 2.843191e-44cat("Resultado Wilcox: p =", wilcox_glucose$p.value, "\n")## Resultado Wilcox: p = 4.552433e-07cat("Resultado Wilcox: p =", wilcox_bmi$p.value, "\n")## Resultado Wilcox: p = 0.003850943Cuanto el vaor de p sea menor más diferencias habrá, por lo que más relevante sera esa variable. Esto nos indica lo anteriormente dicho que las variables de edad y nivel de gluocasa tienen bastante relevancia sobre si alguien tiene un derrame y que la variable bmi no tiene tanto peso.
3 PCA para reducción de dimensionalidad
3.1 PCA con prcomp
PCA <- prcomp(~bmi + age + avg_glucose_level, data = train, scale =TRUE)
plot(PCA)
summary(PCA)## Importance of components:
## PC1 PC2 PC3
## Standard deviation 1.2349 0.9097 0.8046
## Proportion of Variance 0.5083 0.2758 0.2158
## Cumulative Proportion 0.5083 0.7842 1.0000Podemos comprobar como la primera componente principal es la más relevante, ya que captura el 50.83% de la varianza total de los datos. Esto significa que PC1 representa la dirección en la que los datos varían más. La segunda componente principal, aunque captura menos varianza, 27.58%, sigue siendo significativa, ya que representa la segunda dirección de máxima varianza en los datos. Finalmente, la tercera componente principal explica el 21.58% de la varianza restante, y aunque sigue siendo relevante, como la primera y segunda componente cubren aproximadamente al 80% de la varianza de los datos, trabajaremos con estas dos.
cat("\nMatriz de rotación o de pesos W: \n")##
## Matriz de rotación o de pesos W:PCA$rotation## PC1 PC2 PC3
## bmi -0.5872979 0.5262007 -0.6149748
## age -0.6284293 0.1823658 0.7561874
## avg_glucose_level -0.5100567 -0.8305754 -0.2235768En la matriz de pesos se muestran valores que indican la correlacón entre las variables originales y los componentes prinicpales.
PC1 está influenciado por todas las variables, con correlaciones negativas para BMI, age y avg_glucose_level. A medida que estas variables aumentan, el valor de PC1 disminuye, entonces PC1 captura la variabilidad asociada a estas tres variables. PC2 está principalmente influenciado por el avg_glucose_level, con una correlación negativa, lo que implica que un mayor nivel de glucosa está relacionado con un menor valor de PC2. En menor medida, PC2 también está influenciado por el BMI, con una correlación positiva. Enotnces PC2 captura la variabilidad que está relacionada tanto por el nivel de glucosa como por el índice de masa corporal, organizando a las personas principalmente según estas dos variables. PC3 está fuertemente influenciado por la edad, con una correlación positiva, lo que indica que un mayor valor en PC3 está asociado con una mayor edad. Además, PC3 tiene una correlación negativa con el BMI, lo que sugiere que PC3 captura la variabilidad relacionada con la edad y el índice de masa corporal.
En resumen, PC1 está influenciado por todas las variables de manera negativa, PC2 destaca el nivel de glucosa y el BMI, y PC3 está más enfocado en la edad y el BMI.
3.2 PCA sin usar una funcón definida para obtenerlas componentes principales
Seleccionar solo las variables continuas y estandarizarlas:
datos_cont <- train[, c("bmi", "age", "avg_glucose_level")]
datos_cont <- na.omit(datos_cont)
datos_estandarizados <- scale(datos_cont)Calcular la matriz de covarianza:
matriz_cov <- cov(datos_estandarizados)Obtener los autovalores y autovectores, y ordenarlos de mayor a menor:
eig <- eigen(matriz_cov)
autovalores <- eig$values
autovectores <- eig$vectors
orden <- order(autovalores, decreasing = TRUE) # Indices para ordenar
autovalores <- autovalores[orden] # Reordenar autovalores
autovectores <- autovectores[ ,orden] # Reordenar autovectores
autovectores## [,1] [,2] [,3]
## [1,] 0.5872979 -0.5262007 0.6149748
## [2,] 0.6284293 -0.1823658 -0.7561874
## [3,] 0.5100567 0.8305754 0.2235768Los autovectores obtenidos son los mismos que la matriz de pesos ob tenida con prcomp() pero multiplicados por -1. Esto no cambia su interpretación, solo la dirección a la que apuntan las componentes principales.
Transformar los datos al nuevo espacio de componentes principales:
PCA_manual <- as.matrix(datos_estandarizados) %*% autovectores Calcular la varianza por cada componente principal
varianza_explicada <- autovalores / sum(autovalores)
varianza_explicada## [1] 0.5083398 0.2758507 0.2158095La varianza coincide con la calculada con prcomp().
Vamos a comparar PC1 a PC2
plot(PCA$x[,1:2],pch=19)
biplot(PCA)
El eje X representa la primera componente principal y el eje Y la segunda. Como se ha mencionado en la matriz de pesos, a mayor valor de las variables, menor valor de PC1. Por lo tanto, cuanto más a la izquierda estén los puntos, mayor será su nivel de glucosa medio, BMI y edad. Y más a la derecha, menor será el valor de estas variables. PC2 está principalmente influenciado por el nivel de glucosa medio, con una correlación negativa. Esto se representa en el mapa como a mayor altura de los puntos, menor nivel de glucosa. Además, PC2 también está influenciado por el BMI, con una correlación positiva, por lo tanto, a mayor altura en el mapa, mayor nivel de BMI. En el mapa destacan dos puntos en la parte superior izquierda. Esto indica que estas observaciones tienen valores altos en todas las variables especialmente en bmi, pero su nivel de glucosa no es tan alto en comparación con las otras dos variables al estar en una zona más alta.
4 Aprendizaje no supervisado
Lo primero que debemos tener en cuenta para el aprendizaje no supervisado es la elección de la métrica que vamos a utilizar. Dado que hemos aplicado PCA sobre las variables continuas, trabajaremos con los componentes principales, que son numéricos. En este caso, utilizaremos la distancia euclidia.
pca_data <- PCA$x[, 1:2]
dist_euclidia <- dist(pca_data, method = "euclidean")La distancia euclidia debe cumplir con las siguientes propiedades para ser considerada una métrica o medida de desemejanza.
La primera métrica que debe de cumplir es la coincidencia: \((\delta(x,y)=0\leftrightarrow x=y)\).
obs1 <- pca_data[1, ]
obs2 <- obs1
# Calcular la distancia euclidia
coincidencia <- dist(rbind(obs1, obs2), method = "euclidean")
coincidencia## obs1
## obs2 0Da 0, por lo tanto cumple la coincidencia
La segunda es no negatividad: \((\delta(x,y)\geq0)\).
obs2 <- pca_data[2, ]
no_neg <- dist(rbind(obs1, obs2), method = "euclidean")
no_neg## obs1
## obs2 0.6912395Da mayor que 0, por lo que cumple la no negatividad.
La tercera es simetría \((\delta(x,y)=\delta(y,x))\).
sim_xy <- dist(rbind(obs1, obs2), method = "euclidean")
sim_yx <- dist(rbind(obs2, obs1), method = "euclidean")
sim_xy -sim_yx## obs1
## obs2 0Al dar la resta 0 las dos tiene el mismo valor, cumple la simetría.
Con esto hemos comprobado que es una medida de desemejanza, pero si ademas verifica la desigualdad triangular \((\delta(x,y)\leq\delta(x,z)+\delta(y,z))\) se tratará de una distancia.
obs3 <- pca_data[3, ]
dt_xy <- dist(rbind(obs1, obs2), method = "euclidean")
dt_xz <- dist(rbind(obs1, obs3), method = "euclidean")
dt_yz <- dist(rbind(obs2, obs3), method = "euclidean")
dt_xz + dt_yz - dt_xy## obs1
## obs3 2.873105Al dar mayor o igual que 0 comprobamos la desigualdad, hemos comprobado que la distancia euclidia cumple con la desigualdad triangular. Al cumplir con las propiedades de una medida de desemejanza y, además, verifica la desigualdad triangular, por lo que se trata de una distancia
4.1 Clustering no jerárquico
fviz_nbclust(pca_data, kmeans, method = "wss") + labs(title = "Método del Codo")
Para saber el valor que le tenemos de asignar a k usamos el método del codo, en este caso parece que 3 es una buena elección para el número óptimo de clusters.Debido a que la recta tiende a ser continua a partir del 3.
k3 <- kmeans(pca_data, centers = 3, nstart = 20)
fviz_cluster(k3, data = pca_data, geom = "point")
Como podemos observar en este cluster , se separan ,muy claramente en 3 , aunque podemos apreciar un par de datos que pueden ser outliers en el cluster 3.
# Obtener los centroides
centroides <- k3$centers[k3$cluster, ]
# Calcular distancias euclidianas de cada punto a su centroide
distancias <- sqrt(rowSums((pca_data - centroides)^2))
# Ver las distancias más altas (posibles outliers)
outliers <- order(distancias, decreasing = TRUE)[1:2] # Tomamos los 2 más alejados
print(outliers)## [1] 813 699pca_limpio <- pca_data[-outliers, ] # Eliminar filas con outliers
k3_limpio <- kmeans(scale(pca_limpio), centers = 3, nstart = 20)
fviz_cluster(k3_limpio, data = scale(pca_limpio)) # Visualizar el nuevo clustering
Tras eliminar los outliers los clusters se ven más definidos y compactos. Observamos una mejor separación entre los tres grupos, lo que indica que la eliminación de outliers nos ha ayudado a mejorar la estructura del clustering.
library(ggplot2)
library(dplyr)
library(tidyr)
# Convertir pca_limpio a un dataframe potwue es una matriz
df_clusterizado <- as.data.frame(pca_limpio)
# Agregar la columna de cluster como factor
df_clusterizado$cluster <- as.factor(k3_limpio$cluster)
# Transformar el dataset a formato largo para ggplot
df_long <- df_clusterizado %>%
pivot_longer(cols = -cluster, names_to = "variable", values_to = "valor")
# Graficar boxplots para cada variable según el cluster
ggplot(df_long, aes(x = cluster, y = valor, fill = cluster)) +
geom_boxplot(alpha = 0.7) +
facet_wrap(~ variable, scales = "free") +
theme_minimal() +
labs(title = "Distribución de Variables por Cluster", x = "Cluster", y = "Valor")
Observando el siguiente boxplot que representa la distribución de cada variable por cluster. PC1 parece ser la variable más representativa para separar los clusters, ya que el Cluster 2 y el Cluster 3 están bien diferenciados a lo largo de esta componente. PC2 tiene una menor capacidad de diferenciación, aunque sigue mostrando cierta separación, especialmente entre Cluster 1 y Cluster 3. Posibles outliers en PC2 (Cluster 3): Se observan algunos valores atípicos (puntos negros) en PC2, especialmente en Cluster 3,como hemos mencionado anteriormente.
#metodo silueta
fviz_nbclust(pca_data, kmeans, method = "silhouette")
sil <- silhouette(k3$cluster, dist(pca_data))
fviz_silhouette(sil)## cluster size ave.sil.width
## 1 1 1036 0.44
## 2 2 384 0.53
## 3 3 1520 0.48
El gráfico de análisis de silueta evalúa la calidad del clustering. A partir del cual podemos sacar algunas conclusiones,el valor promedio de la silueta (0.47).Un valor cercano a 1 indica que los clusters están bien separados.Un valor cercano a 0 sugiere que los puntos están en el límite entre clusters.En nuestro caso, 0.47 indica una separación moderada, pero puede haber cierta superposición. Distribución de los clusters: -El cluster (3) tiene la mayoría de los datos y una buena cohesión, aunque algunos puntos tienen baja silueta. -El cluster (2) es más pequeño y está mejor definido. -El cluster (1) tiene una forma más dispersa y algunos valores cercanos a 0, lo que indica que algunos puntos pueden estar mal asignados.Y pueden deberse a los outliers que hemos mencionado antes
El clustering es aceptable, pero podría mejorarse para lograr una mejor separación de los grupos.
4.2 Clustering jerárquico
# Método de Ward
hc5 <- hclust(dist_euclidia, method = "ward.D2" )
# Cortamos en 3 clusters
sub_grp <- cutree(hc5, k = 3)
# Visualizamos el corte
plot(hc5, cex = 0.6)
rect.hclust(hc5, k = 3, border = 2:5)
# Número de observaciones en cada cluster
table(sub_grp)## sub_grp
## 1 2 3
## 1359 1284 297# Visualización
fviz_cluster(list(data=pca_data,cluster=sub_grp))
Hemos generado un dendograma mediante el método de Ward para así ver las distancias y saber en cuantos grupos dividir nuestros datos , y nuestra eleccón ha sido 3 al igual que en los no jerárquicos. Los cluster 2 y 3 se ven modificados respectos a los no jerarquicos y como hemos comprobado con el método de la silueta , no son perfectos y se pueden mejorar las diferentes agrupaciones.
5 Conclusión
El objetivo de este análisis fue aplicar técnicas de aprendizaje automático para analizar los factores que pueden influir en la probabilidad de sufrir un derrame cerebral, utilizando un conjunto de datos disponible en Kaggle, que incluye diversas variables de salud de los pacientes. El desarrollo incluye la comprensión del problema, la preparación y exploración de los datos, la reducción de dimensionalidad mediante análisis de componentes principales, y la aplicación de técnicas de clustering no supervisado. El conjunto de datos nos ha proporcionado información valiosa sobre pacientes y sus características de salud, lo que nos permitió identificar variables clave.
A través del análisis exploratorio de datos, identificamos relaciones significativas entre la variable objetivo y el resto de variables, como la relación entre la edad y la probabilidad de sufrir un derrame cerebral, así como la influencia de factores como los problemas cardíacos y los niveles de glucosa. También observamos que algunas variables, como el tipo de residencia o el estado de tabaquismo, no mostraban una relación clara con la variable objetivo, por lo que no las hemos considerado relevantes para la predicción.
Utilizamos PCA para reducir la dimensionalidad de las variables continuas, lo que nos ha permitido capturar la mayor parte de la varianza con dos componentes principales. Esto simplificó el análisis posterior y facilitó la visualización de los datos en un espacio de menor dimensión.
En la fase de aprendizaje no supervisado, aplicamos técnicas de clustering, tanto jerárquicas como no jerárquicas, para identificar grupos en los datos. Utilizamos la distancia euclidia como métrica, verificando que cumplía con las propiedades necesarias para ser considerada una medida de desemejanza válida. El método del codo nos ayudó a determinar el número óptimo de clusters, y los resultados mostraron una agrupación de los datos en función de las características de los pacientes. También hemos creado un boxplot para así saber acerca de que variables pertenecen cada cluster y hemos conseguido comprender que variables logran tener más importancia para así diferenciarse de las demás . En nuestro caso hemos usado variables del PCA porque son las más relevantes. Para comprobar como de bien quedan separados los cluster hemos utilizado el método de la silueta, el cual nos ha ayudado a ver que nuestros clusters calculados están bien pero podrían ser mejorados. Este proyecto nos permitió aplicar conceptos teóricos de aprendizaje automático a un problema real, destacando la importancia de la preparación de datos y el análisis exploratorio como pasos fundamentales antes de la modelización que nos facilitaron trabajar a posteriori con los datos.
En conclusión, el análisis realizado ha permitido obtener información valiosa sobre los factores que influyen en la probabilidad de sufrir un derrame cerebral y se ha logrado una comprensión más profunda del conjunto de datos. Estos resultados pueden servir como base para desarrollar modelos predictivos que nos ayuden a identificar a las personas con mayor riesgo de sufrir un derrame cerebral, lo que a su vez podría contribuir a la prevención y el tratamiento oportuno de este problema de salud.
Parte de cada uno hecho en el trabajo : Hemos hecho todos un poco de cada parte.